@@ -1,3 +1,12 @@
+1.3051      27.05.2011
+    ** Security release based on 1.3050 **
+
+    [ SECURITY ]
+    * FIX CVE-2011-1589 (Mojolicious report, but Dancer was vulnerable as well).
+      Return "400 Bad Request" when requested filename seems suspicious
+      http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2011-1589
+      (Vladimir Lettiev and Franck Cuny)
+
 1.3050      20.05.2011
     ** Codename: The Captain Hook Adventure // Franck Cuny **
 

@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Dancer
-version:            1.3050
+version:            1.3051
 abstract:           A minimal-effort oriented web application framework
 author:  []
 license:            perl

@@ -11,7 +11,7 @@ use Cwd 'realpath';
 use base 'Exporter';
 use vars '@EXPORT_OK';
 
-@EXPORT_OK = qw(path dirname read_file_content read_glob_content open_file set_file_mode);
+@EXPORT_OK = qw(path real_path dirname read_file_content read_glob_content open_file set_file_mode);
 
 # Undo UNC special-casing catfile-voodoo on cygwin
 sub _trim_UNC {
@@ -38,6 +38,8 @@ sub d_splitpath { File::Spec->splitpath(_trim_UNC(@_)) }
 
 sub path { d_catfile(@_) }
 
+sub real_path { realpath( d_catfile(@_) ) }
+
 sub path_no_verify {
     my @nodes = File::Spec->splitpath(d_catdir(@_)); # 0=vol,1=dirs,2=file
     my $path = '';

@@ -13,7 +13,7 @@ use Dancer::Request;
 use Dancer::Response;
 use Dancer::Serializer;
 use Dancer::Config 'setting';
-use Dancer::FileUtils qw(path dirname read_file_content open_file);
+use Dancer::FileUtils qw(path real_path dirname read_file_content open_file);
 use Dancer::SharedData;
 use Dancer::Logger;
 use Dancer::MIME;
@@ -145,10 +145,20 @@ sub serialize_response_if_needed {
 }
 
 sub get_file_response {
-    my $request     = Dancer::SharedData->request;
-    my $path_info   = $request->path_info;
-    my $app         = Dancer::App->current;
-    my $static_file = path($app->setting('public'), $path_info);
+    my $request   = Dancer::SharedData->request;
+    my $path_info = $request->path_info;
+
+    # requests that have \0 in path are forbidden
+    if ( $path_info =~ /\0/ ) {
+        _bad_request();
+        return 1;
+    }
+
+    my $app = Dancer::App->current;
+    my $static_file = real_path( $app->setting('public'), $path_info );
+
+    return if ( !$static_file
+        || index( $static_file, real_path( $app->setting('public') ) ) != 0 );
 
     return Dancer::Renderer->get_file_response_for_path( $static_file, undef,
         $request->content_type );
@@ -189,6 +199,12 @@ sub _get_mime_type {
     return $mime->for_file($file);
 }
 
+sub _bad_request{
+    my $response = Dancer::SharedData->response() || Dancer::Response->new();
+    $response->status(400);
+    $response->content('Bad Request');
+}
+
 # set of builtin templates needed by Dancer when rendering HTML pages
 sub templates {
     my $charset = setting('charset') || 'UTF-8';

@@ -5,7 +5,7 @@ use warnings;
 use Carp;
 use Cwd 'realpath';
 
-our $VERSION   = '1.3050';
+our $VERSION   = '1.3051';
 our $AUTHORITY = 'SUKRIA';
 
 use Dancer::App;

@@ -16,7 +16,7 @@ my $changelog_filename = 'CHANGES';
 my $stop_checking_version = '1.3014';
 
 # ordered list of possible sections
-my @possible_sections = ('API CHANGES', 'BUG FIXES', 'ENHANCEMENTS', 'DOCUMENTATION', );
+my @possible_sections = ('SECURITY', 'API CHANGES', 'BUG FIXES', 'ENHANCEMENTS', 'DOCUMENTATION', );
 
 #################
 

@@ -1,17 +1,60 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3, import => ['!pass'];
+# There is an issue with HTTP::Parser::XS while parsing an URI with \0
+# Using the pure perl via PERL_ONLY works
+BEGIN { $ENV{PERL_ONLY} = 1; }
+
+use Test::More tests => 8, import => ['!pass'];
 use Dancer::Test;
 
 use Dancer ':syntax';
 
-set public => path(dirname(__FILE__), 'static');
+set public => path( dirname(__FILE__), 'static' );
 my $public = setting('public');
 
 my $req = [ GET => '/hello.txt' ];
 response_is_file $req;
 
 my $resp = Dancer::Test::_get_file_response($req);
-is_deeply($resp->headers_to_array, ['Content-Type' => 'text/plain'], "response header looks good for @$req");
-is(ref($resp->{content}), 'GLOB', "response content looks good for @$req");
+is_deeply(
+    $resp->headers_to_array,
+    [ 'Content-Type' => 'text/plain' ],
+    "response header looks good for @$req"
+);
+is( ref( $resp->{content} ), 'GLOB', "response content looks good for @$req" );
+
+ok $resp = Dancer::Test::_get_file_response( [ GET => "/hello\0.txt" ] );
+my $r = Dancer::SharedData->response();
+is $r->status,  400;
+is $r->content, 'Bad Request';
+
+SKIP: {
+    skip "Test::TCP is required", 2
+      unless Dancer::ModuleLoader->load('Test::TCP');
+    skip "Plack is required", 2
+      unless Dancer::ModuleLoader->load('Plack::Loader');
+    require HTTP::Request;
+    require LWP::UserAgent;
+
+    Test::TCP::test_tcp(
+        client => sub {
+            my $port = shift;
+            my $req =
+              HTTP::Request->new(
+                GET => "http://127.0.0.1:$port/hello%00.txt" );
+            my $ua  = LWP::UserAgent->new();
+            my $res = $ua->request($req);
+            ok !$res->is_success;
+            is $res->code, 400;
+        },
+        server => sub {
+            my $port = shift;
+            setting apphandler => 'PSGI';
+            Dancer::Config->load;
+            my $app = Dancer::Handler->psgi_app;
+            Plack::Loader->auto( port => $port )->run($app);
+            Dancer->dance();
+        }
+    );
+}